#!/usr/bin/perl
#
use strict;
use warnings;
use Tk;

my $mw = new MainWindow();

my $can = $mw -> Canvas(-width      => 800,
	                -height     => 600,
                       -cursor => 'crosshaiplusr');

my ($x0, $y0, $x1, $y1);

$x0 = int rand 800;
$y0 = int rand 600;

my @line_ids;

for my $i (1..40) {
    $x1 = int rand 800;
    $y1 = int rand 600;

    my $tag = sprintf("tag%d", $i % 3);
    my $dash;
    if    ($tag eq 'tag0') {
        $dash = undef;
    }
    elsif ($tag eq 'tag1') {
        $dash = '-';
    }
    else {
        $dash = '.';
    }

    my $id = $can -> createLine($x0, $y0, $x1, $y1,
                                -tag     => $tag,
                                -dash    => $dash);

    $x0 = $x1;
    $y0 = $y1;
    push (@line_ids, $id);
}


$can -> bind('tag0', '<1>', [\&setfill, 'tag0', 'blue']);
$can -> bind('tag1', '<1>', [\&setfill, 'tag1', 'red']);
$can -> bind('tag2', '<1>', [\&setfill, 'tag2', 'green']);

$can -> Tk::bind('<2>', [\&resetfill, \@line_ids]);



$can -> pack();

MainLoop();



# ------------------------------------------------------------------------
# Callbacks
# ------------------------------------------------------------------------

sub setfill {
    my $can   = shift;
    my $tag   = shift;
    my $color = shift;

    $can -> itemconfigure ($tag, -fill => $color);
    return;
}

sub resetfill {
    my $widget = shift;
    my $line_ids_ref = shift;

    foreach my $id (@$line_ids_ref) {
        $can -> itemconfigure ('all', -fill => 'black');
    }
    return;
}

